perm filename PUZZLE.IL[TIM,LSP]1 blob
sn#681190 filedate 1982-10-07 generic text, type T, neo UTF8
(FILECREATED " 6-Oct-82 18:55:16" <CSD.BENNETT>PUZZLE.2.4 7014
changes to: PUZZLECOMS PUZZLEFNS FIT PLACE)
(PRETTYCOMPRINT PUZZLECOMS)
(RPAQQ PUZZLECOMS [(FNS * PUZZLEFNS)
(VARS * PUZZLEVARS)
(BLOCKS * PUZZLEBLOCKS)
(P (DEFINE-ARRAY CLASS FIXNUM (ADD1 TYPEMAX))
(DEFINE-ARRAY PIECEMAX FIXNUM (ADD1 TYPEMAX))
(DEFINE-ARRAY PUZZLE T (IPLUS SIZE 2))
(DEFINE-ARRAY PX T (ADD1 TYPEMAX)
(IPLUS SIZE 2))
(DEFINE-ARRAY PIECECOUNT FIXNUM (IPLUS CLASSMAX 2)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML DEFINE-ARRAY)
(LAMA])
(RPAQQ PUZZLEFNS (FIT PLACE REMOVE! TRIAL DEFINEPIECE START *SETA *ELT DEFINE-ARRAY))
(DEFINEQ
(FIT
[LAMBDA (I J)
([LAMBDA (END)
(PROG (K)
(SETQ K 0)
LOOP(COND
((IGREATERP K END)
(RETURN T)))
[COND
((*ELT PX I (ADD1 K))
(COND
((ELT PUZZLE (IPLUS J K))
(RETURN NIL]
(SETQ K (ADD1 K))
(GO LOOP]
(IDIFFERENCE (ELT PIECEMAX (ADD1 I))
1])
(PLACE
[LAMBDA (I J)
([LAMBDA (END)
(PROG (K)
(SETQ K 0)
LOOP(COND
((IGREATERP K END)
(RETURN NIL)))
(COND
((*ELT PX I (ADD1 K))
(SETA PUZZLE (IPLUS J K)
T)))
(SETQ K (ADD1 K))
(GO LOOP))
(SETA PIECECOUNT (ELT CLASS I)
(IDIFFERENCE (ELT PIECECOUNT (ELT CLASS I))
1))
(PROG (K)
(SETQ K J)
LOOP(COND
((IGREATERP K SIZE)
(RETURN 1)))
(COND
((NOT (ELT PUZZLE K))
(RETURN K)))
(SETQ K (ADD1 K))
(GO LOOP]
(SUB1 (ELT PIECEMAX I])
(REMOVE!
[LAMBDA (I J)
([LAMBDA (END)
(PROG (K)
(SETQ K 0)
LOOP(COND
((IGREATERP K END)
(RETURN NIL)))
(COND
((*ELT PX I (ADD1 K))
(SETA PUZZLE (IPLUS J K)
NIL)))
(SETQ K (ADD1 K))
(GO LOOP))
(SETA PIECECOUNT (ELT CLASS)
(ADD1 (ELT PIECECOUNT (ELT CLASS I]
(SUB1 (ELT PIECEMAX I])
(TRIAL
[LAMBDA (J)
((LAMBDA (K)
(PROG (I)
(SETQ I 0)
LOOP(COND
((IGREATERP I TYPEMAX)
(SETQ KOUNT (ADD1 KOUNT))
(RETURN NIL)))
[COND
((NOT (IEQP (ELT PIECECOUNT (ELT CLASS I))
0))
(COND
((FIT I J)
(SETQ K (PLACE I J))
(COND
((OR (TRIAL K)
(IEQP K 1))
(SETQ KOUNT (ADD1 KOUNT))
(RETURN T))
(T (REMOVE! I J]
(SETQ I (ADD1 I))
(GO LOOP))
0])
(DEFINEPIECE
[LAMBDA (ICLASS II JJ KK)
([LAMBDA (INDEX)
(PROG (I)
(SETQ I 0)
LOOP(COND
((IGREATERP I II)
(RETURN NIL)))
(PROG (J)
(SETQ J 0)
LOOP(COND
((IGREATERP J JJ)
(RETURN NIL)))
(PROG (K)
(SETQ K 0)
LOOP(COND
((IGREATERP K KK)
(RETURN NIL)))
[SETQ INDEX (ADD1 (IPLUS I (ITIMES D (IPLUS J (ITIMES D K]
(*SETA PX III INDEX T)
(SETQ K (ADD1 K))
(GO LOOP))
(SETQ J (ADD1 J))
(GO LOOP))
(SETQ I (ADD1 I))
(GO LOOP))
(SETA CLASS III ICLASS)
(SETA PIECEMAX III INDEX)
(COND
((NOT (IEQP III TYPEMAX))
(SETQ III (IPLUS III 1]
1])
(START
[LAMBDA NIL
(PROG (M)
(SETQ M 1)
LOOP(COND
((IGREATERP M SIZE)
(RETURN NIL)))
(SETA PUZZLE M T)
(SETQ M (ADD1 M))
(GO LOOP))
(PROG (I)
(SETQ I 1)
LOOP(COND
((IGREATERP I 5)
(RETURN NIL)))
(PROG (J)
(SETQ J 1)
LOOP(COND
((IGREATERP J 5)
(RETURN NIL)))
(PROG (K)
(SETQ K 1)
LOOP(COND
((IGREATERP K 5)
(RETURN NIL)))
(SETA PUZZLE [ADD1 (IPLUS I (ITIMES D (IPLUS J (ITIMES D K]
NIL)
(SETQ K (ADD1 K))
(GO LOOP))
(SETQ J (ADD1 J))
(GO LOOP))
(SETQ I (ADD1 I))
(GO LOOP))
(PROG (I)
(SETQ I 1)
LOOP(COND
((IGREATERP I TYPEMAX)
(RETURN NIL)))
(PROG (M)
(SETQ M 1)
LOOP(COND
((IGREATERP M SIZE)
(RETURN NIL)))
(*SETA PX I M NIL)
(SETQ M (ADD1 M))
(GO LOOP))
(SETQ I (ADD1 I))
(GO LOOP))
(SETQ III 1)
(DEFINEPIECE 1 3 1 0)
(DEFINEPIECE 1 1 0 3)
(DEFINEPIECE 1 0 3 1)
(DEFINEPIECE 1 1 3 0)
(DEFINEPIECE 1 3 0 1)
(DEFINEPIECE 1 0 1 3)
(DEFINEPIECE 2 2 0 0)
(DEFINEPIECE 2 0 2 0)
(DEFINEPIECE 2 0 0 2)
(DEFINEPIECE 3 1 1 0)
(DEFINEPIECE 3 1 0 1)
(DEFINEPIECE 3 0 1 1)
(DEFINEPIECE 4 1 1 1)
(SETA PIECECOUNT 1 13)
(SETA PIECECOUNT 2 3)
(SETA PIECECOUNT 3 1)
(SETA PIECECOUNT 4 1)
([LAMBDA (M N KOUNT)
(COND
((FIT 1 M)
(SETQ N (PLACE 1 M)))
(T (TERPRI)
(PRIN1 "Error")))
(COND
((TRIAL N)
(TERPRI)
(PRIN1 "success in ")
(PRIN1 KOUNT)
(PRIN1 " trials"))
(T (TERPRI)
(PRIN1 "failure")))
(TERPRI]
(IPLUS 2 (ITIMES D (IPLUS 1 D)))
1 0])
(*SETA
[LAMBDA (ARRAY I J VALUE) (* jsb: "30-Sep-82 15:46")
(SETA (ELT ARRAY I)
J VALUE])
(*ELT
[LAMBDA (ARRAY I J) (* jsb: "30-Sep-82 15:46")
(ELT (ELT ARRAY I)
J])
(DEFINE-ARRAY
[NLAMBDA (NAME TYPE DIM1 DIM2) (* jsb: "30-Sep-82 15:52")
(PROG (ARRAY P)
(SETQ DIM1 (EVAL DIM1))
(SETQ DIM2 (EVAL DIM2))
[COND
[DIM2 (* Matrix defn)
(SET NAME (SETQ ARRAY (ARRAY DIM1 0)))
(SETQ P (SELECTQ TYPE
(FIXNUM DIM2)
(T 0)
(HELP "Invalid matrix type:" TYPE)))
(for I from 1 to DIM1 do (SETA ARRAY I (ARRAY DIM2 P]
(T (SET NAME (ARRAY DIM1 (SELECTQ TYPE
(FIXNUM DIM1)
(T 0)
(HELP "Invalid array type:" TYPE]
(RETURN NAME])
)
(RPAQQ PUZZLEVARS (SIZE TYPEMAX D CLASSMAX))
(RPAQQ SIZE 511)
(RPAQQ TYPEMAX 13)
(RPAQQ D 8)
(RPAQQ CLASSMAX 3)
(RPAQQ PUZZLEBLOCKS ((START FIT PLACE REMOVE! TRIAL DEFINEPIECE *SETA *ELT (ENTRIES START)
(SPECVARS CLASS PIECEMAX PUZZLE P PIECECOUNT))))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: START FIT PLACE REMOVE! TRIAL DEFINEPIECE *SETA *ELT (ENTRIES START)
(SPECVARS CLASS PIECEMAX PUZZLE P PIECECOUNT))
]
(DEFINE-ARRAY CLASS FIXNUM (ADD1 TYPEMAX))
(DEFINE-ARRAY PIECEMAX FIXNUM (ADD1 TYPEMAX))
(DEFINE-ARRAY PUZZLE T (IPLUS SIZE 2))
(DEFINE-ARRAY PX T (ADD1 TYPEMAX)
(IPLUS SIZE 2))
(DEFINE-ARRAY PIECECOUNT FIXNUM (IPLUS CLASSMAX 2))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML DEFINE-ARRAY)
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (762 6150 (FIT 774 . 1103) (PLACE 1107 . 1674) (REMOVE! 1678 . 2041) (TRIAL 2045 . 2514) (DEFINEPIECE 2518
. 3257) (START 3261 . 5147) (*SETA 5151 . 5304) (*ELT 5308 . 5452) (DEFINE-ARRAY 5456 . 6147)))))
STOP